home *** CD-ROM | disk | FTP | other *** search
- Option Explicit
-
- ' This module contains routines and stuff specific to this app.
-
- Global Const APP_VERSION_NUMBER = "1.0.0.0.0.0.0.0.1 Rev A"
- Global Const APP_TITLE = "TT Editor"
- Global Const APP_HELPFILE = "NOTEPAD.HLP"
- Global Const NEW_FILE_TITLE = "<Untitled>"
-
-
- Global Const BUTTON_OPEN = 0
- Global Const BUTTON_NEW = 1
- Global Const BUTTON_PRINT = 2
- Global Const BUTTON_CUT = 3
- Global Const BUTTON_COPY = 4
- Global Const BUTTON_PASTE = 5
- Global Const BUTTON_FIND = 6
- Global Const BUTTON_TOOLTIPS = 7
- Global Const BUTTON_HELP = 8
-
- Global Const TOTAL_BUTTONS = 9
-
- 'Declare an array for each type of Mulitple Instance forms
- Global Forms_frmTextEdit() As New frmTextEdit
-
- ' Give each Class of Mulitple Instance form an identifying number
- ' Calling it "class" will really anoy your VC++ friends !!
-
- Global Const CLASS_frmTextEdit = 1
-
- Sub EditMenu (Enable As Integer)
- MDI.mnu_File_Save.Enabled = Enable
- MDI.mnu_File_SaveAs.Enabled = Enable
- MDI.mnu_File_Print.Enabled = Enable
- MDI.mnu_Edit_Copy.Enabled = Enable
- MDI.mnu_Edit_Cut.Enabled = Enable
- MDI.mnu_Edit_Delete.Enabled = Enable
- MDI.mnu_Edit_Paste.Enabled = Enable
- MDI.mnu_Edit_SelectAll.Enabled = Enable
- MDI.mnu_Edit_TimeDate.Enabled = Enable
- MDI.mnu_Edit_Undo.Enabled = Enable
- MDI.mnu_Edit_WordWrap.Enabled = Enable
- MDI.mnu_Search_Find.Enabled = Enable
- MDI.mnu_Search_FindNext.Enabled = Enable
- Call SynchButtons
- End Sub
-
- Sub FindNextText (Search As String, Down As Integer, Compare As Integer)
- Dim Temp$
- Dim X As Integer
- Dim Start As Integer
- Dim C As Control
- Set C = MDI.ActiveForm.ActiveControl
- Start = C.SelStart + C.SelLength + 1
- If Compare Then Compare = 0 Else Compare = 1
- Temp$ = C
- If Down Then
- X = InStr(Start, Temp$, Search, Compare)
- Else
- Start = InStr(1, Temp$, Search, Compare)
- X = Start
- Do
- Start = InStr(Start + 1, Temp$, Search, Compare)
- If Start And Start < C.SelStart - 1 Then X = Start Else Exit Do
- Loop
- End If
- If X Then
- C.SelStart = X - 1
- C.SelLength = Len(Search)
- Else
- X = MsgBox("Cannot find " & Chr(34) & Search & Chr(34), MB_ICONINFORMATION + MB_OK)
- End If
- End Sub
-
- Sub GetWindowPos (F As Form)
- Dim lpFileName$, lpDefault%
- Dim lpAppName$, lpKeyName$, X As Integer
- lpAppName$ = F.Caption
- lpFileName$ = App.EXEName & ".ini"
-
- lpDefault% = Screen.Height * .1
- lpKeyName$ = "Top"
- X = GetPrivateProfileInt(lpAppName$, lpKeyName$, lpDefault%, lpFileName$)
- If X Then F.Top = X Else F.Top = lpDefault%
-
- lpDefault% = Screen.Width * .1
- lpKeyName$ = "Left"
- X = GetPrivateProfileInt(lpAppName$, lpKeyName$, lpDefault%, lpFileName$)
- If X Then F.Left = X Else F.Left = lpDefault%
-
- lpDefault% = Screen.Width * .8
- lpKeyName$ = "Width"
- X = GetPrivateProfileInt(lpAppName$, lpKeyName$, lpDefault%, lpFileName$)
- If X Then F.Width = X Else F.Width = lpDefault%
-
- lpDefault% = Screen.Height * .8
- lpKeyName$ = "Height"
- X = GetPrivateProfileInt(lpAppName$, lpKeyName$, lpDefault%, lpFileName$)
- If X Then F.Height = X Else F.Height = lpDefault%
-
- End Sub
-
- Sub Main ()
- If App.PrevInstance Then
- App.Title = "... duplicate instance."
- AppActivate APP_TITLE
- SendKeys "% R", True
- End
- End If
- Screen.MousePointer = 11: DoEvents ' Hourglass
- App.HelpFile = APP_HELPFILE
- Call Init_FormDetails
- frmAbout.Show
- frmAbout.Refresh
- DoEvents
- Call SetWindowPos(frmAbout.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
- MDI.Show
- Call DragAcceptFiles(MDI.hWnd, True) 'identify App to accept d/d messages
- Unload frmAbout
- If Len(Command$) Then
- Dim Temp$
- Temp$ = OpenFile(Command$)
- If Len(Temp$) Then
- Call NewFile
- MDI.ActiveForm.Caption = UCase$(Command$)
- MDI.ActiveForm.txtTextEdit = Temp$
- End If
- End If
- Screen.MousePointer = 0
- Call Main_Loop
- End Sub
-
- Sub Main_Loop ()
- Do While DoEvents()
- If MDI.WindowState <> MINIMIZED Then
- Call UpdateStatusBar(MDI.StatusBar)
- Call TT_Test
- Call UpdateEditMenu
- End If
- Call CheckDragDrop(CInt(MDI.hWnd))
- Loop
- End Sub
-
- Function OpenFile (FileName As String) As String
- On Error Resume Next
- Dim Handle As Integer
- Dim X As Integer
- ' Test to see whether the file is already open
- For X = 0 To Forms.Count - 1
- If Forms(X).Caption = FileName Then
- Forms(X).SetFocus
- Exit Function
- End If
- Next
- ' Attempt to open the file if it isn't already
- Handle = FreeFile
- Open FileName For Binary As Handle
- If LOF(Handle) > 60000 Then
- Close Handle
- X = MsgBox("File is too large. Launch Write instead ?", MB_ICONQUESTION + MB_OKCANCEL)
- If X = IDOK Then
- Handle = Shell("Write.exe " & FileName, 1)
- End If
- Else
- OpenFile = Input$(LOF(Handle), Handle)
- Close Handle
- End If
- End Function
-
- Sub SaveWindowPos (F As Form)
- Dim lpFileName$, lpValue$
- Dim lpAppName$, lpKeyName$
-
- lpAppName$ = F.Caption
- lpFileName$ = App.EXEName & ".ini"
-
- lpKeyName$ = "Top"
- lpValue$ = F.Top
- If WritePrivateProfileString(lpAppName$, lpKeyName$, lpValue$, lpFileName$) Then
- End If
- lpKeyName$ = "Left"
- lpValue$ = F.Left
- If WritePrivateProfileString(lpAppName$, lpKeyName$, lpValue$, lpFileName$) Then
- End If
- lpKeyName$ = "Width"
- lpValue$ = F.Width
- If WritePrivateProfileString(lpAppName$, lpKeyName$, lpValue$, lpFileName$) Then
- End If
- lpKeyName$ = "Height"
- lpValue$ = F.Height
- If WritePrivateProfileString(lpAppName$, lpKeyName$, lpValue$, lpFileName$) Then
- End If
-
- End Sub
-
- Sub UpdateEditMenu ()
- Dim C As Control
- If Not Screen.ActiveForm Is Forms(0) Then
- Set C = Screen.ActiveControl
- If Not C Is Nothing Then
- MDI.mnu_Edit_Undo.Enabled = sendMessage(C.hWnd, EM_CANUNDO, 0, ByVal 0&)
- MDI.mnu_Edit_Paste.Enabled = IsClipboardFormatAvailable(CF_TEXT) Or IsClipboardFormatAvailable(CF_OEMTEXT) Or IsClipboardFormatAvailable(CF_DSPTEXT)
- MDI.mnu_Edit_Cut.Enabled = (sendMessage(C.hWnd, EM_GETSEL, 0, ByVal 0&) And &HFFFF&) - (sendMessage(C.hWnd, EM_GETSEL, 0, ByVal 0&) \ &H10000 And &HFFFF&)
- MDI.mnu_Edit_Copy.Enabled = MDI.mnu_Edit_Cut.Enabled
- MDI.mnu_Edit_Delete.Enabled = MDI.mnu_Edit_Cut.Enabled
- Call SynchButtons
- End If
- End If
- End Sub
-
- Sub WriteFile (FileName As String, FileData As String)
- Dim X As Integer
- Dim Handle As Integer
- On Error Resume Next
- Err = False
- Handle = FreeFile
- Open FileName For Output As Handle
- Print #Handle, FileData
- Close Handle
- If Err Then X = MsgBox("An Error occured while saving.", MB_OK)
- End Sub
-
-